home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / ANSISAVE.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  3KB  |  87 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 90 of 132
  3. From : Eric Miller                         1:387/307.0          02 May 93  20:29
  4. To   : Steven Tallent
  5. Subj : Screen to ansi
  6. ────────────────────────────────────────────────────────────────────────────────
  7. { quoted from carbon unit Steven Tallent to Stephen Cheok
  8.   about Re: Screen to ansi on 04-30-93  06:47
  9.  
  10.  ST> This is a procedure I translated from one of my old QuickBASIC
  11.  ST> programs. This color processing is, to say the least, unoptimized, but
  12.  ST> it'll give you the basic idea and you can go from there... like adding
  13.  ST> more than 25-line support, adding maximum line depths, and optimizing
  14.  ST> the color code output.
  15.  
  16.   I rewrote your code into a procedure that actually works in
  17.   TP (just to save you time...not!)  Now it works well, but the
  18.   only probably I have is setting the max line length for the output
  19.    file (like TheDraw does)                      }
  20.  
  21.  
  22. PROGRAM Ansi_Save_Screen;
  23. { This program saves a color text screen to an ANSI text file.
  24. }
  25. Uses Dos;
  26.  
  27. PROCEDURE SaveANSI (Filename: PathStr);
  28. CONST Esc = #27;
  29.       MaxCol = 80;
  30.       AnsiCols: array[0..7] of char = '04261537';
  31. TYPE
  32.   TCell = RECORD C: Char; A: byte; END;
  33.   TScreen = array[1..25, 1..80] of TCell;
  34. VAR
  35.   Screen: TSCreen ABSOLUTE $B800:0;
  36.   F: text;
  37.   X, Y, LastF, LastB, TempF, TempB: byte;
  38.   S: String;
  39.   Blink, Bright: boolean;
  40. BEGIN
  41.   Assign(F, filename);
  42.   Rewrite(F);
  43.   S :=  Esc+'[2J'+Esc+'[0m';
  44.   Write(F, S);
  45.   LastF := Screen[Y, X].A MOD 16;
  46.   LastB := Screen[Y, X].A SHR 4;
  47.   Blink := (LastB AND 8) = 8;
  48.   Bright := (LAstF AND 8) = 8;
  49.   S := '';
  50.   FOR Y := 1 TO 25 DO
  51.     BEGIN
  52.      FOR X := 1 TO 80 DO
  53.        BEGIN
  54.          TempF := Screen[Y, X].A MOD 16;
  55.          TempB := Screen[Y, X].A SHR 4;
  56.          IF (LastB <> TempB) OR (LastF <> TempF) THEN
  57.            BEGIN
  58.              LastB := TempB;
  59.              LastF := TempF;
  60.              S := Concat(S, Esc+'[0;');
  61.              IF (LastF AND 8) = 8 THEN
  62.                IF NOT Bright THEN
  63.                  BEGIN
  64.                    S := Concat(S, '1;');
  65.                    Bright := True;
  66.                 END;
  67.              IF (LastB AND 8) = 8 THEN S := Concat(S, '5;');
  68.              LastF := LastF AND 7;
  69.              LastB := LAstB AND 7;
  70.              S := Concat(S, '3'+AnsiCols[LastF]+';4'+AnsiCols[LastB]+'m');
  71.            END;
  72.          S := Concat(S, Screen[Y, X].C);
  73.          IF Length(S) >= MaxCol THEN
  74.            BEGIN
  75.              Write(F, S);
  76.              Writeln(F,Esc+'[s');
  77.              Write(F, Esc+'[u');
  78.              S := '';
  79.             END;
  80.        END;
  81.     END;
  82.     Write(F, Esc+'[0;37;40m');
  83.     Close(F);
  84. END;
  85. BEGIN
  86.   SaveANSI('test3.ans');
  87. END.